perm filename CYCDRI[1,LMM] blob sn#034847 filedate 1973-04-12 generic text, type T, neo UTF8
  (DE SLOPE (X1 X2 Y1 Y2)
      (CONS (DIFFERENCE X1 X2)
            (DIFFERENCE Y1 Y2)))

  (DE YINTCP (X1 X2 Y1 Y2)
      (CONS (DIFFERENCE (TIMES Y1 X2)
                        (TIMES X1 Y2))
            (DIFFERENCE X2 X1)))

  (DE CONCT (X Y)
      (OR (EQ (CAAR Y)
              (CAAR X))
          (EQ (CAAR Y)
              (CDAR X))
          (EQ (CDAR Y)
              (CAAR X))
          (EQ (CDAR Y)
              (CDAR X))))

  (DE CLCINTA (X X1 X2)
      (NOT (MINUSP (TIMES (DIFFERENCE (CAR X) (TIMES X1 (CDR X)))
                          (DIFFERENCE (CAR X) (TIMES X2 (CDR X)))))))

  (DE GEQ (X Y) (NOT (LESSP X Y)))

  (DE OUTNDS NIL (PROG (I)
                       (SETSCALE 10 20 10 20)
		       (INITDRAW)
                       (POSLABEL 13 13 TITLE)
                       (FOR I := (1 NMX)
                        WHEN (NOT (ZEROP (NODE I)))
                        AS NEW LL IS (CDR (ASSOC2 I LABELL))
                         DO (POSLABEL (NODE I) (NODE (PLUS I 20)) (COND(LL LL)(T I))))
                       (FOR NEW LIN IN (CAR (LAST STACK))
                         DO (LINE2 (CADR LIN)
			          (NODE (CAAR LIN))
                                  (NODE (PLUS (CAAR LIN) 20))
                                  (NODE (CDAR LIN))
                                  (NODE (PLUS (CDAR LIN) 20))))
                       (RETURN (ENDDRAW))))))))))))

  (DE SETSCALE (XMN XMX YMN YMX)
      (PROG NIL (SETQ XBOT (MINUS XMN))
            (SETQ XSCL (QUOTIENT REALWIDTH (PLUS 1 (DIFFERENCE XMX XMN))))
            (SETQ YBOT (MINUS YMN))
            (SETQ YSCL (QUOTIENT REALHEIGHT (PLUS 1 (DIFFERENCE YMX YMN))))))

  (DE POSLABEL (X Y MS) (PROG2 (POS X Y) (LABELL MS)))
 
  (DE POS (X Y) (AIVECT (SCALX X) (SCALY Y)))

  (DE SCALX (X) (SCALE X XBOT XSCL REALEFT))
  (DE SCALE (X XMN XMP START)
      (PLUS START (FIX (PLUS (TIMES XMP (PLUS X XMN))  0.5))))))
  (DE SCALY (Y) (SCALE Y YBOT YSCL REALBOTTOM))

  (DE LABELL (MS)(PROG2 (DTYOS) (PRINC MS) (DTYOU)))))))

  (DE LINE (X1 Y1 X2 Y2) (PROG2 (POS X1 Y1) (XDRAW X2 Y2))))))

  (DE XDRAW (X Y) (AVECT (SCALX X) (SCALY Y)))))))))

  (DE LINE2 (MULT X1 Y1 X2 Y2)
      (PROG2 (LINE X1 Y1 X2 Y2)
             (COND ((NOT(GREATERP MULT 1)) NIL)(T
              (PROG (DELTX DELTY DX DENOM DY)
    		(SETQ DELTX (DIFFERENCE X1 X2))
		(SETQ DELTY (DIFFERENCE Y2 Y1))
		(SETQ DENOM (SQRT (PLUS (TIMES DELTX DELTX)
				  	(TIMES DELTY DELTY))))
		(SETQ DX (TIMES EPSILON (QUOTIENT DELTY DENOM)))
		(SETQ DY (TIMES EPSILON (QUOTIENT DELTX DENOM)))
		(FOR NEW I :=(2 MULT) DO
		 (LINE (SETQ X1 (PLUS X1 DX))
		       (SETQ Y1 (PLUS Y1 DY))
		       (SETQ X2 (PLUS X2 DX))
		       (SETQ Y2 (PLUS Y2 DY))))))))))))))))))


(DE ENDDRAW () (SHOW 1))))

(DE INITDRAW () (CLEAR)))

(SETQ EPSILON 0.05)

  (QUOTE (DEFINE PLEASE UNION SORT))